home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / GFXFX2.ZIP / SCR_TXT1.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-02-14  |  2.1 KB  |  83 lines
  1.  
  2. program text_sinus_scroll; { SCR_TXT1.PAS }
  3. { Smooth sinus-scroll in textmode, by Bas van Gaalen }
  4. uses u_vga,u_txt,u_kb;
  5. const
  6.   sspd=-1;
  7.   samp=75;
  8.   sofs=250;
  9.   slen=255;
  10.   vseg:word=$b800;
  11.   txt:string='Another way to scroll... :-)     ';
  12. var
  13.   stab:array[0..255] of word;
  14.  
  15. procedure setimage(ch:char; var data);
  16. var offset:word;
  17. begin
  18.   offset:=ord(ch)*32;
  19.   inline($fa);
  20.   portw[$03c4]:=$0402;
  21.   portw[$03c4]:=$0704;
  22.   portw[$03ce]:=$0204;
  23.   portw[$03ce]:=$0005;
  24.   portw[$03ce]:=$0006;
  25.   move(data,ptr($a000,offset)^,8);
  26.   portw[$03c4]:=$0302;
  27.   portw[$03c4]:=$0304;
  28.   portw[$03ce]:=$0004;
  29.   portw[$03ce]:=$1005;
  30.   portw[$03ce]:=$0e06;
  31.   inline($fb);
  32. end;
  33.  
  34. procedure initialize;
  35. var charset:array[0..7] of byte; i:byte;
  36. begin
  37.   setvideo(259);
  38.   {cursoroff;}
  39.   dspat('In case you don''t believe it: this is textmode...',1,0,white);
  40.   placecursor(50,0);
  41.   for i:=0 to 7 do begin
  42.     fillchar(charset,sizeof(charset),0);
  43.     charset[i]:=7;
  44.     setimage(chr(128+i),charset);
  45.   end;
  46. end;
  47.  
  48. procedure scroll;
  49. var
  50.   postab:array[0..79,0..7] of word;
  51.   bitmap:array[0..79,0..7] of byte;
  52.   sctr,tctr,curchar,l,b,x,y:byte;
  53. begin
  54.   fillchar(postab,sizeof(postab),0);
  55.   fillchar(bitmap,sizeof(bitmap),0);
  56.   sctr:=0; tctr:=1;
  57.   repeat
  58.     curchar:=ord(txt[tctr]); tctr:=1+tctr mod length(txt);
  59.     for b:=0 to 7 do begin
  60.       move(bitmap[1,0],bitmap[0,0],sizeof(bitmap));
  61.       for l:=0 to 7 do
  62.         if ((mem[seg(font^):ofs(font^)+8*curchar+l] shl b) and 128)<>0 then
  63.           bitmap[79,l]:=1 else bitmap[x,y]:=0;
  64.       vretrace;
  65.       for x:=0 to 79 do for y:=0 to 7 do mem[vseg:postab[x,y]]:=32;
  66.       for x:=0 to 79 do for y:=0 to 7 do begin
  67.         postab[x,y]:=(y+(stab[(sctr+x) mod slen] div 8))*160+x+x;
  68.         if bitmap[x,y]=1 then mem[vseg:postab[x,y]]:=128+stab[(sctr+x) mod slen] mod 8;
  69.       end;
  70.       sctr:=(sctr+sspd) mod slen;
  71.     end;
  72.   until keypressed;
  73. end;
  74.  
  75. var i:byte;
  76. begin
  77.   initialize;
  78.   getfont(font8x8);
  79.   for i:=0 to 255 do stab[i]:=round(sin(4*pi*i/slen)*samp)+sofs;
  80.   scroll;
  81.   setvideo(u_lm);
  82. end.
  83.